home *** CD-ROM | disk | FTP | other *** search
/ Ham Radio 2000 #2 / Ham Radio 2000 - Volume 2.iso / HAMV2 / MISC / HCAL-27 / CUSTOHM.BAS (.txt) < prev    next >
Encoding:
GW-BASIC  |  1997-01-28  |  4.6 KB  |  174 lines
  1. 10  'CUSTOHM - 10 AUG 92 rev. 27 SEP 96
  2. 20  IF EX$=""THEN EX$="EXIT"
  3. 30  CLS:KEY OFF
  4. 40  COLOR 7,0,1
  5. 50  UL$=STRING$(80,205)
  6. 60  U$="##,###"
  7. 70  U1$="##"
  8. 80  U2$="#####,###.##"
  9. 90  U3$="#####.#"
  10. 100  U4$="####.#"
  11. 110  O$=CHR$(234)     'omega
  12. 120  DIM Q(20,3)      'quantity,value,net resistance
  13. 130  DIM R(24)        '24 combinations
  14. 140  DIM C$(10)       'colour codes
  15. 150  '.....standard 5% resistors
  16. 160  DATA 1,1.1,1.2,1.3,1.5,1.6,1.8,2.0,2.2,2.4,2.7,3
  17. 170  DATA 3.3,3.6,3.9,4.3,4.7,5.1,5.6,6.2,6.8,7.5,8.2,9.1
  18. 180  FOR Z=1 TO 24
  19. 190  READ R(Z)
  20. 200  NEXT Z
  21. 210  '.....colour codes
  22. 220  DATA Blk,Brn,Red,Orn,Yel,Grn,Blu,Vio,Gry,Wht
  23. 230  FOR Z=O TO 9
  24. 240  READ C$(Z)
  25. 250  NEXT Z
  26. 260  '
  27. 270  '.....menu
  28. 280  CLS
  29. 290  COLOR 15,2
  30. 300  PRINT " RESISTORS in PARALLEL";TAB(57);"by George Murphy VE3ERP ";
  31. 310  COLOR 1,0:PRINT STRING$(80,223);
  32. 320  COLOR 7,0
  33. 330  T=8      'tab for text
  34. 340  GOSUB 1220
  35. 350  COLOR 0,7:LOCATE CSRLIN+1,22
  36. 360  PRINT " Press 1 to continue or 0 to EXIT....."
  37. 370  COLOR 7,0
  38. 380  Z$=INKEY$:IF Z$=""THEN 380
  39. 390  IF Z$="0"THEN CLS:RUN EX$
  40. 400  IF Z$="1"THEN 420
  41. 410  GOTO 380
  42. 420  VIEW PRINT 3 TO 24:CLS:VIEW PRINT:LOCATE 3
  43. 430  '
  44. 440  INPUT " ENTER: Value of custom resistor (ohms).......";RC
  45. 450  LOCATE CSRLIN-1
  46. 460  '
  47. 470  '.....calculate resistor banks
  48. 480  N=0
  49. 490  FOR Y=1 TO 10            'no. of resistors loop
  50. 500   RX=RC*Y                 'value of resistor
  51. 510   M=1                     'multiplier
  52. 520    FOR Z=1 TO 24
  53. 530     IF R(Z)*M>RX THEN 580
  54. 540    NEXT Z
  55. 550   M=M*10
  56. 560   GOTO 520
  57. 570  '
  58. 580   R1=R(Z-1)*M                      'next lower resistor
  59. 590   IF Z=1 THEN R1=R(12)*M/10
  60. 600   N=N+1                            'counter
  61. 610   Q(N,1)=Y                         'quantity of resistors in bank
  62. 620   Q(N,2)=R1                        'value of each resistor
  63. 630   Q(N,3)=R1/Y                      'net resistance of resistor bank
  64. 640  '
  65. 650   R2=R(Z)*M                        'next higher resistor
  66. 660   N=N+1                            'counter
  67. 670   Q(N,1)=Y                         'quantity of resistors in bank
  68. 680   Q(N,2)=R2                        'value of each resistor
  69. 690   Q(N,3)=R2/Y                      'net resistance of resistor bank
  70. 700  NEXT Y
  71. 710  '
  72. 720  '******START SORT******
  73. 730  SN=N
  74. 740  SM=SN
  75. 750  SM=INT(SM/2):IF SM=0 THEN 840
  76. 760  SK=SN-SM:SJ=1
  77. 770  SI=SJ
  78. 780  SL=SI+SM
  79. 790  IF Q(SI,3)<=Q(SL,3)THEN 820
  80. 800  FOR A=1 TO 3:SWAP Q(SI,A),Q(SL,A):NEXT A
  81. 810  SI=SI-SM:IF SI>0 THEN 780
  82. 820  SJ=SJ+1:IF SJ>SK THEN 750
  83. 830  GOTO 770
  84. 840  '******SORT COMPLETED******
  85. 850  '
  86. 860  '....display data
  87. 870  VIEW PRINT 3 TO 24:CLS:VIEW PRINT:LOCATE 3
  88. 880  FOR Z=1 TO N
  89. 890   PC=ABS(Q(Z,3)-RC)/RC*100                   '% off target
  90. 900   IF Q(Z,1)=1 THEN P$=STRING$(13,32)+"="ELSE P$=" in parallel ="
  91. 910   IF Q(Z-1,3)<=RC AND Q(Z,3)>RC THEN GOSUB 1480
  92. 920   IF PC<=5 THEN COLOR 15,2 ELSE COLOR 7,0
  93. 930  PRINT TAB(3);
  94. 940   PRINT USING U1$;Q(Z,1);                    'print quantity
  95. 950   R=Q(Z,2):V$=O$                             'value
  96. 960    R$=STR$(R)
  97. 970    L$=STR$(LEN(R$)-3)
  98. 980    Q$=LEFT$(R$,2):GOSUB 1160:C1$=C$
  99. 990    Q$=MID$(R$,3,1):GOSUB 1160:C2$=C$
  100. 1000    Q$=LEFT$(L$,2):GOSUB 1160:C3$=C$
  101. 1010    CC$=C1$+"/"+C2$+"/"+C3$
  102. 1020   IF R>=10000 THEN R=R/1000:V$="K"
  103. 1030   IF R<10 THEN X$=U4$ ELSE X$=U$
  104. 1040   PRINT"  @";USING X$;R;                     'print value
  105. 1050   PRINT " ";V$;P$;
  106. 1060   PRINT USING U2$;Q(Z,3);:PRINT " ";O$;      'print net resistance of bank
  107. 1070   IF Q(Z,3)=RC THEN PRINT "      ON TARGET !";:GOTO 1090
  108. 1080   PRINT USING U3$;PC;:PRINT " % off target"; 'discrepancy
  109. 1090  IF R<10 THEN CC$="     -     "
  110. 1100  PRINT TAB(68);CC$
  111. 1110  NEXT Z
  112. 1120  PRINT UL$;
  113. 1130  GOSUB 1610             'screen dump
  114. 1140  GOTO 270
  115. 1150  '
  116. 1160  '.....calculate colour code
  117. 1170  FOR CC=0 TO 9
  118. 1180  IF CC=VAL(Q$)THEN C$=C$(CC):GOTO 1200
  119. 1190  NEXT CC
  120. 1200  RETURN
  121. 1210  '
  122. 1220  '.....text page
  123. 1230  PRINT TAB(T);
  124. 1240  PRINT "This program designs custom resistors that will be very close to"
  125. 1250  PRINT TAB(T);
  126. 1260  PRINT "almost any reasonable value, using standard common resistors"
  127. 1270  PRINT TAB(T);
  128. 1280  PRINT "connected in parallel."
  129. 1290  PRINT
  130. 1300  PRINT TAB(T);
  131. 1310  PRINT "The program calculates several combinations of resistors, any of"
  132. 1320  PRINT TAB(T);
  133. 1330  PRINT "which will provide a net resistance close to your target value."
  134. 1340  PRINT
  135. 1350  PRINT TAB(T);
  136. 1360  PRINT "Each combination displayed shows what percentage it is off the"
  137. 1370  PRINT TAB(T);
  138. 1380  PRINT "target resistance. Combinations within 5% of the target value"
  139. 1390  PRINT TAB(T);
  140. 1400  PRINT "are high-lighted."
  141. 1410  PRINT
  142. 1420  PRINT TAB(T);
  143. 1430  PRINT "Just enter the value of the custom resistor you want and the"
  144. 1440  PRINT TAB(T);
  145. 1450  PRINT "computer will do the rest !"
  146. 1460  RETURN
  147. 1470  '
  148. 1480  '.....hi-lite sought resistance
  149. 1490  COLOR 14,4
  150. 1500  PRINT " TARGET RESISTANCE";
  151. 1510  PRINT STRING$(11,".");USING U2$;RC;
  152. 1520  PRINT " ";O$;
  153. 1530   FOR L=1 TO 80
  154. 1540   Y=SCREEN(CSRLIN,L)
  155. 1550   IF Y=234 THEN 1570
  156. 1560   NEXT L
  157. 1570   PRINT STRING$(78-L,32);
  158. 1580  COLOR 7,0
  159. 1590  RETURN
  160. 1600  '
  161. 1610  'HARDCOPY
  162. 1620  GOSUB 1730:LOCATE 25,2:COLOR 14,6
  163. 1630  PRINT " Press 1 to print screen, 2 to print screen & ";
  164. 1640  PRINT "advance paper, or 3 to continue.";:COLOR 7,0
  165. 1650  Z$=INKEY$:IF Z$="3"THEN GOSUB 1730:RETURN
  166. 1660  IF Z$="1"OR Z$="2"THEN GOSUB 1730:GOTO 1680
  167. 1670  GOTO 1650
  168. 1680  FOR QX=1 TO 24:FOR QY=1 TO 80
  169. 1690  LPRINT CHR$(SCREEN(QX,QY));
  170. 1700  NEXT QY:NEXT QX
  171. 1710  IF Z$="2"THEN LPRINT CHR$(12)
  172. 1720  GOTO 1620
  173. 1730  LOCATE 25,1:PRINT STRING$(80,32);:RETURN
  174.